home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / comp0_89.lha / Feel / Boot / Compiler / compile.em < prev    next >
Lisp/Scheme  |  1993-07-03  |  3KB  |  122 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: compile.em
  4. ;; Date: Wed Jan  8 17:41:44 1992
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;   Top level interface to compiler
  9.  
  10. (defmodule compile
  11.   (standard0
  12.    list-fns
  13.    
  14.    comp-utl  ;; These two plus 1st fn should be in a module of their own
  15.    syntax
  16.    pass-0
  17.    gen-code
  18.    iface
  19.    output
  20.    out-fast
  21.  
  22.    rshow
  23.    stop
  24.    )
  25.   ()
  26.   
  27.   (defun get-module-body (name)
  28.     (let ((stream (get-module-stream name)))
  29.       (unwind-protect 
  30.       (read stream)
  31.     (close stream))))
  32.  
  33.   (defcondition Compiler-Error ())
  34.  
  35.   (deflocal compile-time-failure ())
  36.  
  37.   (defun compile-2-ast (name)
  38.     (setq compile-time-failure nil)
  39.     (with-handler compile-time-error-handler
  40.      (let ((ast (translate (get-module-body name))))
  41.        (annotate-tree ast)
  42.        (if compile-time-failure 
  43.        (progn (format t "Compile failed. Abandoning...~%")
  44.           (error "Compiler-Error" Compiler-Error))
  45.      (progn (setq y ast)
  46.         (cons ast (generate-code ast)))))))
  47.  
  48.   (defun my-handler (escape)
  49.     (lambda (cond cont)
  50.       (flush (standard-error-stream))
  51.       (flush (standard-output-stream))
  52.       (if (eq (class-of cond) Compiler-Error)
  53.       (escape cond)
  54.     (progn (format t "A compiler error has occured"))
  55.     ;;(backtrace)
  56.     (flush (standard-error-stream))
  57.     (flush (standard-output-stream))
  58.     )))
  59.   
  60.   (defgeneric compile-time-error-handler (cond cont)
  61.     methods ((((err Module-State-Error) cont)
  62.           (apply format t
  63.              (slot-value err 'msg)
  64.              (slot-value err 'values))
  65.           (setq compile-time-failure t)
  66.           (cont))
  67.          (((err Syntax-Error) cont)
  68.           (apply format t
  69.              (slot-value err 'msg)
  70.              (slot-value err 'values))
  71.           (setq compile-time-failure t)
  72.           (cont))
  73.          ;; re-raise this 'cos I can't continue
  74.          (((err Compile-Time-Error) cont)
  75.               (apply format t
  76.                      (slot-value err 'msg)
  77.                      (slot-value err 'values))
  78.           (setq compile-time-failure t)
  79.           (error "Compiler Failure" Compiler-Error))
  80.          ;; don't know what it is, so panic.
  81.          (((x <object>) cont)
  82.           nil)))
  83.  
  84.   ;; random vbles to allow debugging
  85.   (deflocal x ())
  86.   (deflocal y ())
  87.   (deflocal a ())
  88.  
  89.   (defun comp2sc (module-name)
  90.     (comp2sc-aux module-name t))
  91.  
  92.   (defun comp2rawsc (module-name)
  93.     (comp2sc-aux module-name nil))
  94.   
  95.   (defun comp2sc-aux (module-name initflag)
  96.     (let/cc outahere
  97.         (with-handler (my-handler outahere)
  98.           (let ((cs (compile-2-ast module-name)))
  99.         (let ((ast (car cs))
  100.               (state (cdr cs)))
  101.           (let ((cu (output-sc-state ast state initflag)))
  102.             (write-interface-file ast)
  103.             (write-fastbytes cu)
  104.             (write-compile-unit cu)
  105.             cu))))))
  106.   
  107.   (defconstant *raw-mods* '(boot-utils newinit initmeth))
  108.  
  109.   (defun compile-boot-modules ()
  110.     (mapc comp2rawsc *raw-mods*)
  111.     (mapc comp2sc '(boot macros0 extras0 defs semaphores standard0)))
  112.  
  113.   (defun compile-module (x)
  114.     (if (memq x *raw-mods*)
  115.     (comp2rawsc x)
  116.       (comp2sc x)))
  117.  
  118.   (export  comp2sc)
  119.  
  120.   ;; end module
  121.   )
  122.